HPAVC/HPAVC CD-ROM.iso/pc/KMAGV2.ZIP/CFEXAM.PAS

Pascal/Delphi Source File | 1995-12-02 | 6.6 KB | 240 lines

{CFEXAM.PAS / EXAMPLE FOR A CROSSFADE EFFECT}
{WRITING BY THE KING IN 10/22/95            }
Uses Crt;
Type
    PicType = Array[0..64000] Of Byte;     {Pointer To The Pictures}
    PicTypeP = ^PicType;

    RGB = Record                           {A Record Of Red,Green,Blue}
        R,G,B:Byte;
    End;

    PalType = Array[0..255] Of RGB;        {256 Color Of Red Green Blue}

    CelHeader=Record                {A Cel File Header}
        Sign:Word;
        W,H:Word;
        X,Y:Word;
        Depth:Byte;
        Compress:Byte;
        Data:LongInt;
        Filler:Array[1..16] OF Byte;
        Pal:PalType;
     End;
Var
    PalP1 : PalType;                        {Palette For Picture 1}
    PalP2 : PalType;                        {Palette For Picture 2}
    PalCP1: PalType;                        {Palette For CrossFade Pic 1}
    PalCP2: PalType;                        {Palette For CrossFade Pic 2}

    Pic1,Pic2 : PicTypeP;            {The Pictures Array}

{--------------------------------------}
{Wait For Vertical Retrace .           }
{--------------------------------------}
Procedure Retrace; Assembler;
Asm
    Mov dx,3dah
@Vert1:
    In Al,Dx
    Test Al,8
    Jz @Vert1
@Vert2:
    In Al,Dx
    Test Al,8
    Jnz @Vert2
End;


{------------------------------------------------}
{Set Mode To Mode 3H , 80x25x16 Colors..         }
{------------------------------------------------}
Procedure SetTextMode;Assembler;
Asm
    Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
    Mov Al,3h
    Int 10h    {SET MODE TO MODE 3 / TEXT MODE}
End;
{-----------------------------------------}
{ Show Picture On Screen .                }
{-----------------------------------------}

Procedure ShowPic(Pic:PicTypeP);Assembler;
  Asm
    Push Ds
    Mov Ax,Word(Pic+2)                {Take The Segment Of Pic}
    Mov Ds,Ax
    Xor Si,Si                         {Si = 0}
    Mov Ax,0a000h
    Mov Es,Ax
    Xor Di,Di                         {Di = 0}
    Mov Cx,32000                      {32000*2 = 64000}
    Rep MovSw                         {Move 32000*2 Bytes}
    Pop Ds
 End;
{-------------------------------------------------------}
{Set Red Green And Blue To a Color                      }
{-------------------------------------------------------}

Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
Asm
    Mov Dx,3c8h                  {SET TO SET COLOR}
    Mov Al,Col
    Out Dx,Al
    Inc Dx                       {DX = 3c9h}
    Mov Al,R                     {Senting Red Value}
    Out Dx,Al
    Mov Al,G                     {Senting Green Value}
    Out Dx,Al
    Mov Al,B                     {Senting Blue Value}
    Out Dx,Al
End;

{---------------------------------------------------}
{ Show The Palette                                  }
{---------------------------------------------------}
Procedure ShowPal(Var Pal:PalType;StartP,EndP:Byte);
Var T:Byte;
Begin
    For T:=StartP To EndP Do
        SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;

{---------------------------------------------------}
{ Fade To The Screen From Palette To Palette.       }
{---------------------------------------------------}
Procedure FadeTo(Pal,ToPal:PalType);
Var
    T,T1:Byte;
Begin
    For T1:=1 To 63 Do
    Begin
        For T:=1 To 255 Do
        Begin
            If Pal[T].R > ToPal[T].R Then
                Dec(Pal[T].R);
            If Pal[T].R < ToPal[T].R Then
                Inc(Pal[T].R);
            If Pal[T].G > ToPal[T].G Then
                Dec(Pal[T].G);
            If Pal[T].G < ToPal[T].G Then
                Inc(Pal[T].G);
            If Pal[T].B > ToPal[T].B Then
                Dec(Pal[T].B);
            If Pal[T].B < ToPal[T].B Then
                Inc(Pal[T].B);
        End;
        ShowPal(Pal,1,255);
        Delay(30);   {Can Be Change To What Speed You Want}
        Retrace;
    End;
End;
{------------------------------------------------}
{Set Mode To Mode 13H , 320x200x256 Colors..     }
{------------------------------------------------}
Procedure SetMode;Assembler;
Asm
       Mov Ah,00h  {Function 00,13 Interrupt 10h / SET MODE}
    Mov Al,13h
    Int 10h     {SETING TO MODE 13H}
End;

{------------------------------------------------}
{Load Cel file .                                 }
{------------------------------------------------}
Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;
Var F:File;
    Cel:CelHeader;
Begin
    {$I-}
    Assign(F,Name);
    Reset(F,1);
    {$I+}
    If IoResult=0 Then
        Begin
            LoadCel:=True;
            BlockRead(F,Cel,SizeOf(Cel));
            BlockRead(F,Where,FileSize(F)-SizeOf(Cel));
            Pal:=Cel.Pal;
            Close(F);
        End
        Else
        Begin
            LoadCel:=False;
        End;
End;
{---------------------------------------------}
{Build The Picture Of The Cross Fade          }
{---------------------------------------------}
Procedure MakeCrossFade;
Var
    Colors : Array[0..255] Of Record
        Pix1,Pix2:Byte;
End;
    T:Word;
    T1:Word;
    Num:Word;
    Pix1,Pix2:Byte;
Begin
    T:=0;
    Num := 1;
    Repeat
        Pix1 := PIC1^[T];
        Pix2 := PIC2^[T];
        For T1 := 0 To Num - 1 Do
        Begin
            If (Num <> 1) And (Pix1=Colors[T1].Pix1) And (Pix2=Colors[T1].Pix2) Then
            Begin
                PIC1^[T] := T1;
                T1:=256;
                Break;
            End
        End;

        If T1 <> 256 Then
        Begin
              PIC1^[T] := Num;
            PalCP1[Num] := PalP1[Pix1];
            PalCP2[Num] := PalP2[Pix2];
            Colors[Num].Pix1 := Pix1;
            Colors[Num].Pix2 := Pix2;
            Num := Num + 1;
        End;
        Inc(T);
        If Num > 255 Then
        Begin
            Writeln('More Then 256 Colors . ');
            Halt;
        End;
    Until(T=64000);
End;
{---------------------------------------------------}
{ Make a BLACK Palette                              }
{---------------------------------------------------}
Procedure ZeroPal(Var Pal:PalType);
Begin
    FillChar(Pal,SizeOf(Pal),0);
End;

Begin
    New(Pic1);                        {Allocate Memory For Pic1}
    New(Pic2);                        {Allocate Memory For Pic1}

    LoadCel('Box.Cel' ,Pic1^,PalP1);  {Load Cel To Pic1 And Pal to PalP1}
    LoadCel('Back.Cel',Pic2^,PalP2);  {Load Cel To Pic2 And Pal to PalP2}
    MakeCrossFade;                    {Make The Cross Fade Picture And Pals}
    SetMode;                          {Set to 320x200x256}
    ZeroPal(PalP1);
    ShowPal(PalP1,1,255);
    ShowPic(Pic1);                    {Show Picture PIC1}
    FadeTo(PalP1,PalCP1);
    Repeat
        FadeTo(PalCp1,PalCp2);        {Fade From PalCP1 To PalCP2}
        FadeTo(PalCp2,PalCp1);        {Fade From PalCP2 To PalCP1}
    Until(KeyPressed);                {Wait For KeyPressed}
    FadeTo(PalCP1,PalP1);
    SetTextMode;
End.